home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue65 / pools / uWebPoolTest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-11-28  |  2.4 KB  |  95 lines
  1. unit uWebPoolTest;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, HTTPApp, IBDatabasePool, DBWeb, IBDatabase,
  7.   IBQuery, DB;
  8.  
  9. type
  10.   TWebModule1 = class(TWebModule)
  11.     pgSales: TPageProducer;
  12.     tpSales: TDataSetTableProducer;
  13.     procedure WebModule1actSalesAction(Sender: TObject;
  14.       Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  15.     procedure pgSalesHTMLTag(Sender: TObject; Tag: TTag;
  16.       const TagString: String; TagParams: TStrings;
  17.       var ReplaceText: String);
  18.   private
  19.     { Private declarations }
  20.   public
  21.     { Public declarations }
  22.   end;
  23.  
  24. var
  25.   WebModule1: TWebModule1;
  26.   DBPool : TIBDatabasePool;
  27.   DBQueue : TIBQueryQueue;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. function DLLFilePath : string;
  34. begin
  35.   SetLength(Result,MAX_PATH);
  36.   GetModuleFileName(HInstance,PCHar(Result),MAX_PATH);
  37.   SetLength(Result,StrLen(PChar(Result)));
  38.  
  39.   Result := ExtractFilePath(Result);
  40. end;
  41.  
  42. procedure TWebModule1.WebModule1actSalesAction(Sender: TObject;
  43.   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  44. var
  45.   s : string;
  46. begin
  47.   try
  48.     s := 'Select * from SALES';
  49.     if Request.QueryFields.Values['Emp']<>'' then
  50.       s := s + ' where SALES_REP='+Request.QueryFields.Values['Emp'];
  51.     tpSales.Dataset := DBQueue.OpenSQL(s,True);
  52.     try
  53.       Response.Content := pgSales.Content;
  54.     finally
  55.       DBQueue.CloseSQL(TIBQuery(tpSales.Dataset));
  56.     end;
  57.   except
  58.     on e: exception do
  59.       Response.Content := e.message;
  60.   end;
  61. end;
  62.  
  63. procedure TWebModule1.pgSalesHTMLTag(Sender: TObject; Tag: TTag;
  64.   const TagString: String; TagParams: TStrings; var ReplaceText: String);
  65. begin
  66.   if Uppercase(TagString)='TABLEHERE' then
  67.   begin
  68.     ReplaceText := tpSales.Content;
  69.   end;
  70. end;
  71.  
  72. initialization
  73.   DBPool := TIBDatabasePool.Create(nil);
  74.   DBQueue := TIBQueryQueue.Create(DBPool);
  75.   DBQueue.IBDatabasePool := DBPool;
  76.   with TStringList.Create do
  77.   try
  78.     LoadFromFile(DLLFilePath+'WebConfig.ini');
  79.     DBPool.MaxConnections := StrToIntDef(Values['MaxDB'],5);
  80.     DBPool.DatabaseName   := Values['DBPath'];
  81.     DBPool.Params.Values['USER_NAME'] := Values['Username'];
  82.     DBPool.Params.Values['PASSWORD']  := Values['Password'];
  83.     DBQueue.MaxQueueFactor := StrToIntDef(Values['QueueFactor'],3);
  84.     DBQueue.QueueManagers := StrToIntDef(Values['QueueMgrs'],1);
  85.   finally
  86.     free;
  87.   end;
  88.   DBPool.OpenAll;
  89.  
  90. finalization
  91.   DBPool.CloseAll;
  92.   DBPool.Free;
  93.  
  94. end.
  95.